home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / bipl.zip / PROGS.ZIP / CONCORD.ICN < prev    next >
Text File  |  1992-09-28  |  3KB  |  112 lines
  1. ############################################################################
  2. #
  3. #    File:     concord.icn
  4. #
  5. #    Subject:  Program to produce concordance
  6. #
  7. #    Author:   Ralph E. Griswold
  8. #
  9. #    Date:     September 6, 1992
  10. #
  11. ###########################################################################
  12. #
  13. #     This program produces a simple concordance from standard input to standard
  14. #  output. Words less than three characters long are ignored.
  15. #
  16. #     There are two options:
  17. #
  18. #    -l n    set maximum line length to n (default 72), starts new line
  19. #    -w n    set maximum width for word to n (default 15), truncates
  20. #
  21. #     There are lots of possibilities for improving this program and adding
  22. #  functionality to it. For example, a list of words to be ignored could be
  23. #  provided.  The formatting could be made more flexible, and so on.
  24. #
  25. ############################################################################
  26. #
  27. #     Note that the program is organized to make it easy (via item()) to
  28. #  handle other kinds of tabulations.
  29. #
  30. ############################################################################
  31. #
  32. #  Links: options
  33. #
  34. ############################################################################
  35.  
  36. link options
  37.  
  38. global uses, colmax, namewidth, lineno
  39.  
  40. procedure main(args)
  41.    local opts, uselist, name, line
  42.    opts := options(args, "l+w+")        # process options
  43.    colmax := \opts["l"] | 72
  44.    namewidth := \opts["w"] | 15
  45.    uses := table()
  46.    lineno := 0
  47.    every tabulate(item(), lineno)        # tabulate all the citations
  48.    uselist := sort(uses, 3)            # sort by uses
  49.    while name := get(uselist) do
  50.       format(left(name, namewidth) || get(uselist))
  51. end
  52.  
  53. #  Add line number to citations for name. If it already has been cited, 
  54. #  add (or increment) the number of citations.
  55. #
  56. procedure tabulate(name, lineno)
  57.    local count, i, j, k, last, head, tail
  58.    lineno := string(lineno)
  59.    if /uses[name] := lineno || ", " then return
  60.    uses[name] ? {
  61.       j := 1                    # token start
  62.       every i := upto(',') + 2 do {        # token end
  63.           k := j
  64.           j := i                # last token start
  65.           }
  66.       head := tab(k)                # everything but last token
  67.       last := tab(many(&digits))        # last line number
  68.       if last ~= lineno then {            # new number
  69.          tail := last || tab(0) || lineno || ", "
  70.          }
  71.       else {                    # repeated number
  72.          if ="(" then count := tab(many(&digits)) + 1 else
  73.             count := 2
  74.          tail := last || "(" || count || "), "
  75.          }
  76.       }
  77.    uses[name] := head || tail
  78.    return
  79. end
  80.  
  81. #  Format the output, breaking long lines as necessary.
  82. #
  83. procedure format(line)
  84.    local i
  85.    while *line > colmax + 2 do {
  86.       i := colmax + 2
  87.       until line[i -:= 1] == " "        # back off to break point
  88.       write(line[1:i])
  89.       line := repl(" ", namewidth) || line[i + 1:0]
  90.       }
  91.    write(line[1:-2])
  92. end
  93.  
  94. #  Get an item. Different kinds of concordances can be obtained by
  95. #  modifying this procedure.
  96. #
  97. procedure item()
  98.    local i, word, line
  99.    while line := read() do {
  100.       lineno +:= 1
  101.       write(right(lineno, 6), "  ", line)
  102.       line := map(line)                # fold to lowercase
  103.       i := 1
  104.       line ? {
  105.          while tab(upto(&letters)) do {
  106.             word := tab(many(&letters))
  107.             if *word >= 3 then suspend word        # skip short words
  108.             }
  109.          }
  110.       }
  111. end
  112.